indiv smooths
Megan Lott
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 380)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 13.05508 13.05019 13.04536 13.04060 13.03591 13.03128 13.02671 13.02220
## [9] 13.01775 13.01336 13.00903 13.00475 13.00052 12.99634 12.99222 12.98815
## [17] 12.98412 12.98014 12.97620 12.97231 12.96845 12.96464 12.96087 12.95713
## [25] 12.95343 12.94976 12.94613 12.94253 12.93895 12.93541 12.93189 12.92840
## [33] 12.92493 12.92148 12.91806 12.91465 12.91127 12.90792 12.90461 12.90133
## [41] 12.89809 12.89489 12.89173 12.88861 12.88553 12.88250 12.87952 12.87659
## [49] 12.87371 12.87088 12.86811 12.86539 12.86273 12.86013 12.85759 12.85512
## [57] 12.85271 12.85036 12.84809 12.84588 12.84375 12.84169 12.83970 12.83779
## [65] 12.83596 12.83421 12.83254 12.83095 12.82945 12.82804 12.82672 12.82545
## [73] 12.82423 12.82304 12.82189 12.82079 12.81972 12.81870 12.81773 12.81679
## [81] 12.81591 12.81507 12.81428 12.81355 12.81286 12.81223 12.81165 12.81113
## [89] 12.81066 12.81025 12.80990 12.80962 12.80939 12.80922 12.80912 12.80909
## [97] 12.80912 12.80921 12.80938 12.80962 12.80993 12.81031 12.81076 12.81129
## [105] 12.81190 12.81258 12.81334 12.81418 12.81511 12.81611 12.81720 12.81837
## [113] 12.81963 12.82113 12.82299 12.82519 12.82771 12.83053 12.83360 12.83692
## [121] 12.84046 12.84418 12.84806 12.85208 12.85622 12.86044 12.86472 12.86903
## [129] 12.87336 12.87767 12.88194 12.88614 12.89025 12.89425 12.89809 12.90177
## [137] 12.90526 12.90852 12.91154 12.91429 12.91793 12.92351 12.93083 12.93970
## [145] 12.94990 12.96125 12.97353 12.98655 13.00010 13.01399 13.02802 13.04198
## [153] 13.05568 13.06891 13.08147 13.09316 13.10378 13.11314 13.12102 13.12723
## [161] 13.13157 13.13592 13.14215 13.15006 13.15942 13.17001 13.18162 13.19404
## [169] 13.20704 13.22041 13.23393 13.24739 13.26057 13.27325 13.28522 13.29626
## [177] 13.30615 13.31468 13.32163 13.32678 13.32992 13.33084 13.33042 13.32973
## [185] 13.32874 13.32747 13.32588 13.32399 13.32177 13.31923 13.31636 13.31314
## [193] 13.30957 13.30565 13.30136 13.29670 13.29166 13.28623 13.28040 13.27417
## [201] 13.26754 13.26048 13.25300 13.24508 13.23672 13.22791 13.21865 13.20892
## [209] 13.19873 13.18805 13.17530 13.15917 13.14012 13.11857 13.09496 13.06974
## [217] 13.04332 13.01617 12.98870 12.96136 12.93458 12.90881 12.88448 12.86203
## [225] 12.84189 12.82450 12.80726 12.78747 12.76539 12.74128 12.71541 12.68804
## [233] 12.65944 12.62987 12.59959 12.56888 12.53798 12.50718 12.47674 12.44691
## [241] 12.41796 12.39016 12.36378 12.33907 12.31630 12.29574 12.27765 12.26103
## [249] 12.24467 12.22858 12.21273 12.19713 12.18176 12.16660 12.15165 12.13690
## [257] 12.12233 12.10794 12.09371 12.07963 12.06570 12.05189 12.03821 12.02464
## [265] 12.01117 11.99778 11.98534 11.97459 11.96537 11.95754 11.95093 11.94539
## [273] 11.94075 11.93687 11.93358 11.93073 11.92815 11.92570 11.92322 11.92055
## [281] 11.91752 11.91399 11.90980 11.90479 11.89880 11.89168 11.88326 11.87395
## [289] 11.86430 11.85435 11.84417 11.83381 11.82333 11.81279 11.80224 11.79175
## [297] 11.78137 11.77117 11.76118 11.75149 11.74213 11.73318 11.72469 11.71636
## [305] 11.70788 11.69929 11.69060 11.68185 11.67307 11.66427 11.65549 11.64676
## [313] 11.63810 11.62954 11.62111 11.61283 11.60473 11.59685 11.58920 11.58181
## [321] 11.57471 11.56794 11.56151 11.55545 11.54963 11.54391 11.53829 11.53276
## [329] 11.52733 11.52201 11.51680 11.51171 11.50672 11.50185 11.49711 11.49249
## [337] 11.48799 11.48362 11.47939 11.47529 11.47134 11.46752 11.46385 11.46032
## [345] 11.45694 11.45371 11.45062 11.44767 11.44486 11.44220 11.43968 11.43731
## [353] 11.43507 11.43298 11.43103 11.42921 11.42754 11.42601 11.42462 11.42337
## [361] 11.42226 11.42129 11.42046 11.41976 11.41920 11.41878 11.41850 11.41835
## [369] 11.41834 11.41847 11.41873 11.41913 11.41967 11.42033 11.42114 11.42207
## [377] 11.42314 11.42435 11.42569 11.42716#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 380)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.61055 12.60648 12.60249 12.59859 12.59476 12.59102 12.58735 12.58377
## [9] 12.58027 12.57684 12.57350 12.57024 12.56705 12.56394 12.56092 12.55797
## [17] 12.55510 12.55230 12.54959 12.54695 12.54439 12.54191 12.53950 12.53717
## [25] 12.53492 12.53274 12.53064 12.52861 12.52666 12.52479 12.52299 12.52126
## [33] 12.51961 12.51803 12.51653 12.51510 12.51374 12.51246 12.51124 12.51010
## [41] 12.50903 12.50803 12.50711 12.50626 12.50549 12.50479 12.50417 12.50363
## [49] 12.50317 12.50279 12.50249 12.50226 12.50212 12.50206 12.50209 12.50220
## [57] 12.50239 12.50267 12.50303 12.50348 12.50402 12.50464 12.50535 12.50616
## [65] 12.50705 12.50803 12.50911 12.51028 12.51154 12.51289 12.51434 12.51593
## [73] 12.51771 12.51968 12.52182 12.52414 12.52662 12.52927 12.53207 12.53502
## [81] 12.53812 12.54136 12.54473 12.54822 12.55185 12.55558 12.55943 12.56339
## [89] 12.56745 12.57160 12.57584 12.58016 12.58456 12.58904 12.59358 12.59818
## [97] 12.60284 12.60755 12.61231 12.61710 12.62193 12.62678 12.63166 12.63655
## [105] 12.64146 12.64637 12.65128 12.65619 12.66108 12.66596 12.67082 12.67565
## [113] 12.68044 12.68551 12.69112 12.69722 12.70376 12.71068 12.71793 12.72546
## [121] 12.73321 12.74113 12.74916 12.75726 12.76536 12.77342 12.78138 12.78919
## [129] 12.79679 12.80413 12.81116 12.81782 12.82406 12.82982 12.83506 12.84067
## [137] 12.84749 12.85539 12.86425 12.87392 12.88428 12.89519 12.90653 12.91816
## [145] 12.92996 12.94179 12.95352 12.96501 12.97615 12.98679 12.99680 13.00606
## [153] 13.01443 13.02178 13.02799 13.03291 13.03865 13.04717 13.05813 13.07120
## [161] 13.08602 13.10227 13.11959 13.13765 13.15611 13.17462 13.19286 13.21046
## [169] 13.22711 13.24244 13.25613 13.26784 13.27722 13.28393 13.28763 13.28950
## [177] 13.29095 13.29198 13.29259 13.29278 13.29255 13.29191 13.29084 13.28935
## [185] 13.28744 13.28512 13.28237 13.27921 13.27563 13.27163 13.26721 13.26237
## [193] 13.25712 13.25145 13.24536 13.23885 13.23193 13.22459 13.21683 13.20866
## [201] 13.20007 13.19106 13.18164 13.17180 13.16155 13.14913 13.13306 13.11375
## [209] 13.09160 13.06701 13.04038 13.01211 12.98262 12.95229 12.92153 12.89075
## [217] 12.86034 12.83071 12.80226 12.77539 12.75051 12.72802 12.70832 12.69181
## [225] 12.67600 12.65827 12.63883 12.61790 12.59567 12.57237 12.54819 12.52334
## [233] 12.49804 12.47250 12.44691 12.42150 12.39647 12.37202 12.34838 12.32574
## [241] 12.30431 12.28431 12.26595 12.24942 12.23495 12.22201 12.20989 12.19850
## [249] 12.18776 12.17757 12.16786 12.15854 12.14951 12.14069 12.13200 12.12334
## [257] 12.11464 12.10580 12.09673 12.08736 12.07759 12.06868 12.06184 12.05685
## [265] 12.05351 12.05164 12.05102 12.05145 12.05274 12.05469 12.05710 12.05975
## [273] 12.06247 12.06504 12.06726 12.06894 12.06988 12.06987 12.06871 12.06621
## [281] 12.06216 12.05637 12.04987 12.04383 12.03818 12.03286 12.02783 12.02302
## [289] 12.01839 12.01387 12.00942 12.00498 12.00049 11.99590 11.99116 11.98621
## [297] 11.98099 11.97545 11.96953 11.96319 11.95636 11.94914 11.94168 11.93399
## [305] 11.92611 11.91805 11.90983 11.90149 11.89303 11.88449 11.87588 11.86724
## [313] 11.85857 11.84991 11.84128 11.83269 11.82418 11.81576 11.80745 11.79929
## [321] 11.79129 11.78347 11.77573 11.76794 11.76011 11.75224 11.74433 11.73638
## [329] 11.72839 11.72038 11.71233 11.70426 11.69616 11.68804 11.67990 11.67174
## [337] 11.66356 11.65537 11.64715 11.63888 11.63055 11.62219 11.61378 11.60533
## [345] 11.59685 11.58834 11.57980 11.57123 11.56264 11.55403 11.54540 11.53677
## [353] 11.52812 11.51947 11.51081 11.50215 11.49350 11.48486 11.47622 11.46764
## [361] 11.45913 11.45069 11.44232 11.43401 11.42574 11.41753 11.40934 11.40119
## [369] 11.39306 11.38495 11.37684 11.36874 11.36063 11.35251 11.34437 11.33621
## [377] 11.32801 11.31977 11.31149 11.30315#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 380)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 12.05956 12.05265 12.04584 12.03915 12.03256 12.02608 12.01971 12.01344
## [9] 12.00728 12.00122 11.99525 11.98939 11.98363 11.97796 11.97239 11.96691
## [17] 11.96152 11.95623 11.95103 11.94591 11.94089 11.93595 11.93109 11.92632
## [25] 11.92163 11.91702 11.91249 11.90804 11.90367 11.89937 11.89515 11.89100
## [33] 11.88692 11.88291 11.87897 11.87510 11.87130 11.86756 11.86389 11.86027
## [41] 11.85672 11.85323 11.84980 11.84645 11.84321 11.84007 11.83705 11.83413
## [49] 11.83132 11.82862 11.82602 11.82353 11.82115 11.81887 11.81670 11.81464
## [57] 11.81268 11.81084 11.80909 11.80745 11.80592 11.80450 11.80318 11.80196
## [65] 11.80086 11.79985 11.79895 11.79816 11.79747 11.79689 11.79641 11.79604
## [73] 11.79577 11.79560 11.79554 11.79559 11.79573 11.79598 11.79628 11.79656
## [81] 11.79685 11.79713 11.79742 11.79772 11.79804 11.79839 11.79878 11.79920
## [89] 11.79966 11.80018 11.80075 11.80139 11.80209 11.80287 11.80374 11.80469
## [97] 11.80573 11.80687 11.80812 11.80948 11.81096 11.81257 11.81430 11.81617
## [105] 11.81819 11.82035 11.82267 11.82515 11.82779 11.83061 11.83361 11.83680
## [113] 11.84018 11.84375 11.84753 11.85152 11.85573 11.86016 11.86481 11.86971
## [121] 11.87528 11.88189 11.88946 11.89788 11.90707 11.91692 11.92733 11.93822
## [129] 11.94948 11.96102 11.97274 11.98455 11.99635 12.00804 12.01953 12.03073
## [137] 12.04153 12.05183 12.06156 12.07060 12.08095 12.09446 12.11081 12.12968
## [145] 12.15074 12.17367 12.19816 12.22388 12.25051 12.27772 12.30521 12.33264
## [153] 12.35969 12.38605 12.41139 12.43540 12.45774 12.47810 12.49616 12.51160
## [161] 12.52409 12.53659 12.55203 12.57008 12.59039 12.61263 12.63644 12.66149
## [169] 12.68743 12.71393 12.74063 12.76721 12.79332 12.81860 12.84274 12.86537
## [177] 12.88617 12.90478 12.92086 12.93408 12.94410 12.95056 12.95432 12.95650
## [185] 12.95719 12.95646 12.95439 12.95106 12.94655 12.94093 12.93429 12.92669
## [193] 12.91823 12.90897 12.89900 12.88840 12.87723 12.86559 12.85354 12.84118
## [201] 12.82857 12.81579 12.80292 12.79005 12.77724 12.76458 12.75214 12.74001
## [209] 12.72826 12.71696 12.70345 12.68538 12.66339 12.63807 12.61004 12.57991
## [217] 12.54830 12.51581 12.48307 12.45068 12.41926 12.38941 12.36176 12.33691
## [225] 12.31548 12.29808 12.28188 12.26378 12.24399 12.22269 12.20009 12.17639
## [233] 12.15177 12.12645 12.10062 12.07447 12.04820 12.02202 11.99611 11.97069
## [241] 11.94594 11.92206 11.89926 11.87772 11.85765 11.83925 11.82271 11.80756
## [249] 11.79314 11.77939 11.76624 11.75362 11.74145 11.72967 11.71821 11.70699
## [257] 11.69595 11.68501 11.67412 11.66318 11.65215 11.64094 11.62949 11.61773
## [265] 11.60558 11.59298 11.58065 11.56931 11.55889 11.54929 11.54044 11.53225
## [273] 11.52464 11.51753 11.51083 11.50447 11.49835 11.49239 11.48652 11.48066
## [281] 11.47470 11.46859 11.46222 11.45553 11.44842 11.44082 11.43264 11.42396
## [289] 11.41498 11.40576 11.39636 11.38684 11.37727 11.36771 11.35822 11.34888
## [297] 11.33974 11.33086 11.32231 11.31416 11.30646 11.29928 11.29269 11.28645
## [305] 11.28028 11.27421 11.26822 11.26233 11.25654 11.25086 11.24529 11.23983
## [313] 11.23450 11.22929 11.22421 11.21927 11.21448 11.20983 11.20533 11.20099
## [321] 11.19682 11.19281 11.18898 11.18532 11.18179 11.17835 11.17499 11.17172
## [329] 11.16855 11.16548 11.16252 11.15968 11.15696 11.15436 11.15190 11.14957
## [337] 11.14739 11.14535 11.14347 11.14175 11.14020 11.13882 11.13761 11.13658
## [345] 11.13572 11.13502 11.13449 11.13412 11.13392 11.13388 11.13401 11.13430
## [353] 11.13476 11.13538 11.13616 11.13711 11.13823 11.13950 11.14094 11.14255
## [361] 11.14432 11.14625 11.14834 11.15059 11.15301 11.15559 11.15833 11.16124
## [369] 11.16430 11.16753 11.17092 11.17447 11.17818 11.18205 11.18608 11.19027
## [377] 11.19463 11.19914 11.20381 11.20864#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")